home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Deutsche Edition 1
/
Deutsche Edition 1.iso
/
amok
/
081-090
/
amok82
/
plot
/
source
/
formelauswertung.mod
< prev
next >
Wrap
Text File
|
1993-11-04
|
23KB
|
804 lines
IMPLEMENTATION MODULE Formelauswertung;
(*
Created: 17.11.87
Changed: 10.02.88/26.8.88/29.9.881/10/88 by
Stefan Salewski
Stolper Weg 3
2160 Stade West-Germany
Tel: 04141/61130
Note: compiled with AMIGA Modula-2 System by AMSoft Version from 5.5.88
*)
FROM Arts IMPORT Error;
FROM MyLongRealConversions IMPORT StrToReal;
FROM MathTrans IMPORT Fieee,Tieee;
FROM MyMathTrans IMPORT Abs,Fac,Sqr,Power,TAN,Cot,Sec,
Cosec,Arcsin,Arccos,Arccot,EXP,Ln,LOG,SIN,COS,Arctan,SINH,Arcoth,Int,
COSH,TANH,Coth,Arsinh,Arcosh,Artanh,SQRT;
FROM MyMathLibLong IMPORT abs,fac,sqr,power,tan,cot,sec,
cosec,arcsin,arccos,arccot,exp,ln,log,sin,cos,arctan,arcoth,int,
sinh,cosh,tanh,coth,arsinh,arcosh,artanh,sqrt,
errorNumber;
FROM String IMPORT Insert,Occurs,Delete;
FROM MyStrings IMPORT Assign,Length;
FROM MyUties IMPORT Buchstabe,Operator,AddOp,IsADigit;
FROM SYSTEM IMPORT FFP,ADR;
(*
Der Bereich Char(1) bis Char(AnzFktn) dient zur Speicherung von
Funktionssymbolen. z.B. arcsin=Char(1); sin=Char(18) usw.
Char(58) bis Char(64) entspricht +,-,*,/,^,(,)
Der Bereich 'A' .. 'z' enthaelt die Werte der definierten Variablen.
Zeichen groesser 127 symbolisieren die Zahlen in der Formel
Nach anwendung von DefFormel enthalt die Formel also nur noch Variablen(A..z),
Zahlen(Char(128)..Char(255)), Funktionsymbole(Char(0)..Char(AnzFktn-1)
und Plus,Minus,Mal,Durch,Hoch,Bra,Ket.
*)
CONST
MaxLongReal=MAX(LONGREAL);
MaxFFP=MAX(FFP);
Plus=CHAR(58);
Minus=CHAR(59);
Mal=CHAR(60);
Durch=CHAR(61);
Hoch=CHAR(62);
Bra=CHAR(63);
Ket=CHAR(64);
AnzFktn=26; (* sin,cos... *)
ErsteZahl=CHAR(128);
LetzteZahl=CHAR(255);
FirstPos=128; (* Position des ersten zur Zahlenspeicherung *)
(* verwendeten Zeichens
Die erste Zahl in der Formel wird ersetzt durch CHAR(128),
die zweite durch Char(129) usw bis maximal Char(255).
Gleichzeitig bekommt Char(128) den Zahlenwert der ersten
Zahl zugewiesen usw.
*)
TYPE
Zahlen=[ErsteZahl..LetzteZahl];
FktnStr=ARRAY[0..6] OF CHAR;
FFPFunktion=PROCEDURE(FFP):FFP;
LongFunktion=PROCEDURE(LONGREAL):LONGREAL;
Position=[0..StrLength-1];
VAR
zahlenspeicherLong:ARRAY Formelnummer,Zahlen OF LONGREAL;
zahlenspeicherFFP:ARRAY Formelnummer,Zahlen OF FFP;
formeln:ARRAY Formelnummer OF Formelstring;
(*length:ARRAY Formelnummer OF CARDINAL;*)
belegt:ARRAY['A'..'z'] OF BOOLEAN;
funktionen:ARRAY[1..AnzFktn] OF FktnStr;
(**********************************************************************)
PROCEDURE Init;
VAR c: CHAR;
BEGIN
FOR c:='A' TO 'z' DO
belegt[c]:=FALSE
END;
funktionen[1]:='arcsin';
funktionen[2]:='arccos';
funktionen[3]:='arctan';
funktionen[4]:='arsinh';
funktionen[5]:='arcosh';
funktionen[6]:='artanh';
funktionen[7]:='arcoth';
funktionen[8]:='arccot';
funktionen[9]:='cosec';
funktionen[10]:='sinh';
funktionen[11]:='cosh';
funktionen[12]:='tanh';
funktionen[13]:='coth';
funktionen[14]:='sqrt';
funktionen[15]:='sqr';
funktionen[16]:='cot';
funktionen[17]:='sec';
funktionen[18]:='sin';
funktionen[19]:='cos';
funktionen[20]:='tan';
funktionen[21]:='log';
funktionen[22]:='exp';
funktionen[23]:='fac';
funktionen[24]:='abs';
funktionen[25]:='int';
funktionen[26]:='ln';
END Init;
(**********************************************************************)
PROCEDURE SoS(c:CHAR):BOOLEAN;
BEGIN
RETURN (c<=CHAR(AnzFktn)) AND (c#0C)
END SoS;
PROCEDURE Zahl(c:CHAR):BOOLEAN;
BEGIN
RETURN (c>CHAR(127)) OR ((c>='A') AND (c<='z'));
END Zahl;
PROCEDURE Gueltig(c:CHAR):BOOLEAN;
BEGIN
RETURN IsADigit(c) OR (Buchstabe(c) OR Operator(c) OR (c='(') OR (c=')')
OR (c='.'))
END Gueltig;
PROCEDURE ASet(c:CHAR):BOOLEAN;
BEGIN
RETURN ((c>=Plus) AND (c<=Hoch)) OR (c=Ket)
END ASet;
PROCEDURE CSet(c:CHAR):BOOLEAN;
BEGIN
RETURN (Zahl(c)) OR (c=Ket)
END CSet;
PROCEDURE DSet(c:CHAR):BOOLEAN;
BEGIN
RETURN (Zahl(c) OR (c=Bra) OR SoS(c))
END DSet;
PROCEDURE FormelOK(VAR str:Formelstring):BOOLEAN;
VAR kl:INTEGER;
i,l:CARDINAL;
BEGIN
l:=Length(str)-1;
FOR i:=0 TO l DO
IF NOT Gueltig(str[i]) THEN RETURN FALSE END
END;
kl:=0;
FOR i:=0 TO l DO
IF str[i]='(' THEN
INC(kl)
ELSIF str[i]=')' THEN
DEC(kl)
END;
IF kl<0 THEN
RETURN FALSE
END
END;
RETURN kl=0
END FormelOK;
PROCEDURE SyntaxOK(VAR str:Formelstring):BOOLEAN;
VAR i,len: CARDINAL;
ok:BOOLEAN;
BEGIN
i:=0;
ok:=TRUE;
IF (str[i]=Ket) OR (str[i]=0C) OR (str[i]=Mal) OR (str[i]=Durch)
OR (str[i]=Hoch) THEN
RETURN FALSE
ELSE
len:=Length(str)-1;
WHILE (i<len) AND ok DO
IF str[i]=Bra THEN
ok:=(str[i+1]#Ket) AND (str[i+1]#Mal) AND (str[i+1]#Durch)
AND (str[i+1]#Hoch)
ELSIF (str[i]=Ket) OR Zahl(str[i]) THEN
ok:=ASet(str[i+1])
ELSIF SoS(str[i]) THEN
ok:=(str[i+1]=Bra)
ELSIF (str[i]>=Plus) AND (str[i]<=Hoch) THEN
ok:=DSet(str[i+1])
ELSE
RETURN FALSE;
END;
INC(i);
END;
END;
IF NOT ok THEN
RETURN FALSE
ELSE
RETURN CSet(str[i])
END;
END SyntaxOK;
PROCEDURE AssignLong(c:CHAR;x:LONGREAL):BOOLEAN;
BEGIN
IF (c>='A') AND (c<='z') THEN
varListLong[c]:=x;
varListFFP[c]:=Fieee(REAL(x));
belegt[c]:=TRUE;
RETURN TRUE
ELSE
RETURN FALSE
END;
END AssignLong;
PROCEDURE AssignFFP(c:CHAR;x:FFP):BOOLEAN;
BEGIN
IF (c>='A') AND (c<='z') THEN
varListLong[c]:=LONGREAL(Tieee(x));
varListFFP[c]:=x;
belegt[c]:=TRUE;
RETURN TRUE
ELSE
RETURN FALSE
END;
END AssignFFP;
PROCEDURE ClearVar(c:CHAR);
BEGIN
IF Buchstabe(c) THEN
belegt[c]:=FALSE
END
END ClearVar;
(**********************************************************************)
PROCEDURE GetLongValue(c:CHAR;VAR x:LONGREAL):BOOLEAN;
BEGIN
IF Buchstabe(c) AND belegt[c] THEN
x:=varListLong[c];
RETURN TRUE
ELSE
RETURN FALSE
END
END GetLongValue;
(**********************************************************************)
PROCEDURE GetFFPValue(c:CHAR;VAR x:FFP):BOOLEAN;
BEGIN
IF Buchstabe(c) AND belegt[c] THEN
x:=varListFFP[c];
RETURN TRUE
ELSE
RETURN FALSE
END
END GetFFPValue;
(**********************************************************************)
PROCEDURE SetBrackets(VAR str:ARRAY OF CHAR):BOOLEAN;
TYPE StrPos=[0..StrLength-1];
VAR i,leftpos,rightpos,laenge:StrPos;
lok:BOOLEAN;
string:Formelstring;
hi:CARDINAL;
PROCEDURE Testelinks(c1,c2,c3,c4:CHAR;i:StrPos;
VAR bPos:StrPos;VAR noetig:BOOLEAN);
VAR j: StrPos;
PROCEDURE Jumpleft;
BEGIN
REPEAT
DEC(j);
IF string[j]=Ket THEN
Jumpleft
END;
UNTIL string[j]=Bra;
IF j>0 THEN
DEC(j)
END;
END Jumpleft;
BEGIN (* Testelinks *)
j:=i;
REPEAT
DEC(j);
IF string[j]=Ket THEN
Jumpleft
END;
noetig:=(string[j]=c1) OR (string[j]=c3) OR (string[j]=c2) OR
(string[j]=c4);
UNTIL noetig OR (string[j]=Bra) OR (j=0);
noetig:=noetig AND (j#0);
(*noetig:=noetig AND NOT ((j=0) AND ((string[0]=Plus) OR (string[i]=Minus));*)
(* noetig:=noetig AND NOT((i>1) AND ((string[j])=Plus) OR
(string[j]=Minus) AND (string[j-1]='E') AND IsADigit(string[j-2]));
*)
bPos:= j+1;
END Testelinks;
PROCEDURE Testerechts(c1,c2,c3,c4:CHAR;i:StrPos;
VAR bPos:StrPos);
VAR j,strLaenge: StrPos;
gesucht:BOOLEAN;
PROCEDURE Jumpright;
BEGIN
REPEAT
INC(j);
IF string[j]=Bra THEN
Jumpright
END;
UNTIL string[j]=Ket;
INC(j);
END Jumpright;
BEGIN
strLaenge:=Length(string);
j:=i;
REPEAT
INC(j);
IF string[j]=Bra THEN
Jumpright
END;
gesucht:=(string[j]=c1) OR (string[j]=c3) OR (string[j]=c2) OR
(string[j]=c4);
UNTIL (j>=strLaenge) OR gesucht OR (string[j]=Ket);
bPos:=j;
IF j=strLaenge THEN
INC(bPos)
END;
END Testerechts;
PROCEDURE Set(lk,rk:StrPos);
(* Setzt Klammern an die Positionen lk und rk *)
BEGIN
Insert(string,lk,Bra);
IF rk=Length(string) THEN
string[rk]:=Ket;
string[rk+1]:=0C
ELSE
Insert(string,rk+1,Ket)
END;
END Set;
BEGIN
hi:=HIGH(str);
laenge:=Length(str);
IF laenge< StrLength-1 THEN
Assign(string,str);
string[laenge]:=0C;
string[laenge+1]:=0C;
string[laenge+2]:=0C;
i:=0;
REPEAT
IF string[i]=Hoch THEN
Testelinks(Mal,Durch,Plus,Minus,i,leftpos,lok);
IF lok THEN
Testerechts(Mal,Durch,Plus,Minus,i,rightpos);
(* IF lok THEN *)
Set(leftpos,rightpos);
INC(laenge,2)
END
END;
INC(i);
UNTIL (i=laenge) OR (laenge>hi);
IF laenge>hi THEN
RETURN FALSE
END;
i:=0;
REPEAT
IF (string[i]=Mal) OR (string[i]=Durch) THEN
Testelinks(Plus,Plus,Minus,Minus,i,leftpos,lok);
IF lok THEN
Testerechts(Plus,Plus,Minus,Minus,i,rightpos);
(* IF lok THEN *)
Set(leftpos,rightpos);
INC(laenge,2)
END
END;
INC(i);
UNTIL (i=laenge) OR (laenge>hi);
IF laenge>hi THEN
RETURN FALSE
END;
Assign(str,string);
RETURN TRUE
ELSE
RETURN FALSE
END;
END SetBrackets;
(**********************************************************************)
PROCEDURE FFPBerechnung(nummer:Formelnummer;
VAR ergebnis:FFP;
VAR fehlernummer:CARDINAL);
VAR pos: CARDINAL;
ch:CHAR;
PROCEDURE Ausdruck():FFP; FORWARD;
PROCEDURE Neuezahl():FFP;
VAR helpChr:CHAR;
BEGIN
IF formeln[nummer,pos]=Bra THEN
INC(pos);
RETURN Ausdruck()
ELSE
helpChr:=formeln[nummer,pos];
INC(pos);
IF (helpChr>='A') AND (helpChr<='z') THEN
RETURN varListFFP[helpChr]
ELSE
RETURN zahlenspeicherFFP[nummer,helpChr]
END
END
END Neuezahl;
PROCEDURE Ausdruck():FFP;
VAR func:FFPFunktion;
oper:CHAR;
argument,ergebnis:FFP;
BEGIN
ergebnis:=0.0;
WHILE (formeln[nummer,pos]#Ket) AND (formeln[nummer,pos]#0C)
AND (errorNumber=0) DO
IF (formeln[nummer,pos]>=Plus) AND (formeln[nummer,pos]<=Hoch) THEN
oper:=formeln[nummer,pos];
INC(pos)
ELSE
oper:=Plus
END;
IF formeln[nummer,pos]<=CHAR(AnzFktn) THEN (* Funktionsberechnung *)
CASE formeln[nummer,pos] OF
01C:func:=Arcsin|
02C:func:=Arccos|
03C:func:=Arctan|
04C:func:=Arsinh|
05C:func:=Arcosh|
06C:func:=Artanh|
07C:func:=Arcoth|
10C:func:=Arccot|
11C:func:=Cosec|
12C:func:=SINH|
13C:func:=COSH|
14C:func:=TANH|
15C:func:=Coth|
16C:func:=SQRT|
17C:func:=Sqr|
20C:func:=Cot|
21C:func:=Sec|
22C:func:=SIN|
23C:func:=COS|
24C:func:=TAN|
25C:func:=LOG|
26C:func:=EXP|
27C:func:=Fac|
30C:func:=Abs|
31C:func:=Int|
32C:func:=Ln|
ELSE
Error(ADR('FFPBerechnung'),ADR('Case Formel... Error'))
END;(* Case *)
INC(pos);
argument:=func(Neuezahl());
ELSE
argument:=Neuezahl();
END;
IF errorNumber=0 THEN
CASE oper OF
Plus:ergebnis:=ergebnis+argument;
IF ABS(ergebnis)>=MaxFFP THEN
errorNumber:=104
END|
Minus:ergebnis:=ergebnis-argument;
IF ABS(ergebnis)>=MaxFFP THEN
errorNumber:=105
END|
Hoch:ergebnis:=Power(ergebnis,argument)|
Mal:ergebnis:=ergebnis*argument;
IF ABS(ergebnis)>=MaxFFP THEN
errorNumber:=103
END|
Durch:IF argument=0.0 THEN
errorNumber:=101
ELSE
ergebnis:=ergebnis/argument;
IF ABS(ergebnis)>=MaxFFP THEN
errorNumber:=102 (*overflov*)
END;
END|
ELSE
Error(ADR('FFPBerechnung'),ADR('Operator... Error'))
END
END
END;
IF formeln[nummer,pos]=Ket THEN INC(pos);END;
RETURN ergebnis
END Ausdruck;
BEGIN (* Auswertung *)
IF formeln[nummer,0]#0C THEN
pos:=0;
errorNumber:=0;
ergebnis:=Ausdruck();
fehlernummer:=errorNumber
ELSE
ergebnis:=0.0;
fehlernummer:=31
END
END FFPBerechnung;
(**********************************************************************)
PROCEDURE LongBerechnung(nummer:Formelnummer;
VAR ergebnis:LONGREAL;
VAR fehlernummer:CARDINAL);
VAR
pos: CARDINAL;
ch:CHAR;
PROCEDURE Ausdruck():LONGREAL; FORWARD;
PROCEDURE Neuezahl():LONGREAL;
VAR helpChr:CHAR;
BEGIN
IF formeln[nummer,pos]=Bra THEN
INC(pos);
RETURN Ausdruck()
ELSE
helpChr:=formeln[nummer,pos];
INC(pos);
IF (helpChr>='A') AND (helpChr<='z') THEN
RETURN varListLong[helpChr]
ELSE
RETURN zahlenspeicherLong[nummer,helpChr]
END
END
END Neuezahl;
PROCEDURE Ausdruck():LONGREAL;
VAR func: LongFunktion;
oper: CHAR;
argument,ergebnis:LONGREAL;
BEGIN
ergebnis:=0.0;
WHILE (formeln[nummer,pos]#Ket) AND (formeln[nummer,pos]#0C)
AND (errorNumber=0) DO
IF (formeln[nummer,pos]>=Plus) AND (formeln[nummer,pos]<=Hoch) THEN
oper:=formeln[nummer,pos];
INC(pos)
ELSE
oper:=Plus
END;
IF formeln[nummer,pos]<=CHAR(AnzFktn) THEN (* Funktionsberechnung *)
CASE formeln[nummer,pos] OF
01C:func:=arcsin|
02C:func:=arccos|
03C:func:=arctan|
04C:func:=arsinh|
05C:func:=arcosh|
06C:func:=artanh|
07C:func:=arcoth|
10C:func:=arccot|
11C:func:=cosec|
12C:func:=sinh|
13C:func:=cosh|
14C:func:=tanh|
15C:func:=coth|
16C:func:=sqrt|
17C:func:=sqr|
20C:func:=cot|
21C:func:=sec|
22C:func:=sin|
23C:func:=cos|
24C:func:=tan|
25C:func:=log|
26C:func:=exp|
27C:func:=fac|
30C:func:=abs|
31C:func:=int|
32C:func:=ln|
ELSE
Error(ADR('LongBerechnung'),ADR('Case Formel... Error'))
END;(* Case *)
INC(pos);
argument:=func(Neuezahl());
ELSE
argument:=Neuezahl();
END;
IF errorNumber=0 THEN
CASE oper OF
Plus:ergebnis:=ergebnis+argument;
IF ABS(ergebnis)>=MaxLongReal THEN
errorNumber:=104
END|
Minus:ergebnis:=ergebnis-argument;
IF ABS(ergebnis)>=MaxLongReal THEN
errorNumber:=105
END|
Hoch:ergebnis:=power(ergebnis,argument)|
Mal:ergebnis:=ergebnis*argument;
IF ABS(ergebnis)>=MaxLongReal THEN
errorNumber:=103
END|
Durch:IF argument=0.0 THEN
errorNumber:=101
ELSE
ergebnis:=ergebnis/argument;
IF ABS(ergebnis)>=MaxLongReal THEN
errorNumber:=102 (*overflov*)
END
END|
ELSE
Error(ADR('LongBerechnung'),ADR('Operator... Error'))
END
END
END;
IF formeln[nummer,pos]=Ket THEN INC(pos) END;
RETURN ergebnis
END Ausdruck;
BEGIN (* Auswertung *)
IF formeln[nummer,0]#0C THEN
pos:=0;
errorNumber:=0;
ergebnis:=Ausdruck();
fehlernummer:=errorNumber
ELSE
ergebnis:=0.0;
fehlernummer:=31
END
END LongBerechnung;
(**********************************************************************)
PROCEDURE DefFormel(nummer:Formelnummer;VAR str:ARRAY OF CHAR;
korrekt,onlyLong:BOOLEAN):CARDINAL;
VAR
testStr:Formelstring;
i,soOft:CARDINAL;
synOK,vD:BOOLEAN;
fehlernummer:CARDINAL;
zeichen:CHAR;
PROCEDURE VarDef(VAR str:Formelstring):BOOLEAN;
VAR i:CARDINAL;
BEGIN
FOR i:=0 TO Length(str)-1 DO
IF ((str[i]>='A') AND (str[i]<='z')) AND NOT belegt[str[i]] THEN
RETURN FALSE
END
END;
RETURN TRUE;
END VarDef;
PROCEDURE Transform(VAR str:Formelstring;VAR wieOft:CARDINAL):BOOLEAN;
(* Substituiert Zahlen im String durch Zeichen
und weist den entsprechenden Feldvariablen den Zahlenwert zu *)
(* 7.98 ==> CHAR(128); zahlenspeicherLong[Char(128)]:=7.98 *)
VAR
i,zahllaenge:Position;
x:LONGREAL;
zeichen:CHAR;
help: ARRAY[0..0] OF CHAR;
vorzZahlmoegl,getOK: BOOLEAN;
PROCEDURE GetNumber(pos:Position; VAR l:Position;VAR x:LONGREAL):BOOLEAN;
(* weist den Wert der Zahl, die an der Position pos im String Str
Steht und l Zeichen lang ist x zu *)
VAR s:Formelstring;
k,i:CARDINAL;
error,zifORadop:BOOLEAN;
BEGIN
error:=FALSE;
i:=pos;
l:=0;
IF (str[i]='+') OR (str[i]='-') THEN
s[0]:=str[i];
INC(l)
END;
WHILE IsADigit(str[i+l]) DO
s[l]:=str[i+l];
INC(l)
END;
IF str[i+l] ='.' THEN
s[l]:=str[i+l];
INC(l);
WHILE IsADigit(str[i+l]) DO
s[l]:=str[i+l];
INC(l);
END
END;
IF str[i+l]='E' THEN
zifORadop:=IsADigit(str[i+1+l]) OR (AddOp(str[i+1+l]) AND
IsADigit(str[i+2+l]));
IF zifORadop THEN
s[l]:= str[i+l];
INC(l);
IF AddOp(str[i+l]) THEN
s[l]:=str[i+l];INC(l)
END;
k:=0;
WHILE IsADigit(str[i+l]) AND (k<3) DO
s[l]:= str[i+l];
INC(l);
INC(k);
END;
onlyLong:=(k=3) OR ((k=2) AND NOT((s[l-2]='0') OR (s[l-2]='1')));
error:= (k<3) OR ((k=3) AND ((s[l-3]='0') OR (s[l-3]='1') OR
(s[l-3]='2')));
error:=NOT error
END
END;
s[l]:=0C;
IF NOT error THEN
StrToReal(s,x,error)
END;
RETURN NOT error
END GetNumber;
BEGIN (* Transform*)
i:=0;
wieOft:=0;
getOK:=TRUE;
WHILE (i<=Length(str)) AND getOK DO
vorzZahlmoegl:=(i=0) OR (str[i-1]='(');
IF IsADigit(str[i]) OR (AddOp(str[i]) AND vorzZahlmoegl AND
IsADigit(str[i+1])) THEN
getOK:=GetNumber(i,zahllaenge,x);
IF getOK THEN
zeichen:=CHR(FirstPos+wieOft);
zahlenspeicherLong[0,zeichen]:=x;
Delete(str,i,zahllaenge);
help[0]:= CHR(FirstPos+wieOft);
IF i= Length(str) THEN
str[i]:=help[0];
str[i+1]:=0C
ELSE
Insert(str,i,help)
END;
INC(wieOft)
END
END;
INC(i)
END;
RETURN getOK
END Transform;
PROCEDURE Substitute(VAR str:Formelstring);
VAR i: CARDINAL;
position:INTEGER;
s:ARRAY[0..1] OF CHAR;
BEGIN
s[1]:=0C;
FOR i:=1 TO AnzFktn DO
position:=0;
REPEAT
position:=Occurs(str,position,funktionen[i],TRUE);
IF position#-1 THEN
Delete(str,position,Length(funktionen[i]));
s[0]:=CHAR(i);
Insert(str,position,s);
INC(position)
END
UNTIL position=-1
END
END Substitute;
BEGIN
IF (str[0]#0C) AND (HIGH(str)<=StrLength) AND (Length(str)<StrLength-2) THEN
Assign(testStr,str);
fehlernummer:=Length(str);
testStr[fehlernummer]:=0C;
testStr[fehlernummer+1]:=0C;
testStr[fehlernummer+2]:=0C;
fehlernummer:=0; (* Kein Fehler *)
IF FormelOK(testStr) THEN
(* Substitute und Transform arbeiten noch mit +,-,...),
danach wird mit Plus,....Ket gearbeitet
*)
Substitute(testStr);
IF Transform(testStr,soOft) THEN
FOR i:=0 TO Length(testStr)-1 DO
CASE testStr[i] OF
'+':testStr[i]:=Plus|
'-':testStr[i]:=Minus|
'*':testStr[i]:=Mal|
'/':testStr[i]:=Durch|
'^':testStr[i]:=Hoch|
'(':testStr[i]:=Bra|
')':testStr[i]:=Ket
ELSE
END
END;
synOK:=SyntaxOK(testStr);
vD:=VarDef(testStr);
IF NOT vD THEN
fehlernummer:=32
ELSIF NOT synOK THEN
fehlernummer:=33
END
ELSE
fehlernummer:=35
END
ELSE
fehlernummer:=34
END;
IF fehlernummer#0 THEN
FOR i:=0 TO StrLength-1 DO formeln[nummer,i]:=0C END
END
ELSIF str[0]=0C THEN
fehlernummer:=31
ELSE
Error(ADR('DefFormel'),ADR('Es muss gelten:Len(str)<StrLength-2'))
END;
IF (fehlernummer=0) AND korrekt THEN
IF NOT SetBrackets(testStr) THEN
fehlernummer:=36
END
END;
IF fehlernummer=0 THEN
Assign(formeln[nummer],testStr);
(*length[nummer]:=Length(testStr);*)
FOR zeichen:= CHR(FirstPos) TO CHR(FirstPos+soOft-1) DO
zahlenspeicherLong[nummer,zeichen]:=zahlenspeicherLong[0,zeichen];
zahlenspeicherFFP[nummer,zeichen]:=
Fieee(REAL(zahlenspeicherLong[0,zeichen]))
END
END;
RETURN fehlernummer;
END DefFormel;
(**********************************************************************)
BEGIN
Init;
END Formelauswertung.mod